home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / bpl70n12.zip / TESTPRGS.ZIP / WHETST87.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-14  |  7KB  |  235 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
  2. {$M 16384,0,655360}
  3.  
  4. { (C) Copyright, A H J Sale and British Standards Institution, 1982 }
  5. {TEST 1.2-1, CLASS=QUALITY}
  6.  
  7. {: This program is a general check on execution speed. }
  8. {  For details, see Computer Journal article, 'A Synthetic
  9.    Benchmark', Jan 1976  pp43-49. }
  10. {V3.0: New test. }
  11. {V5.1: Modified to introduce validation checks, 88-02-24}
  12. program tlp2d1(output);
  13.  
  14. { The validation checks added have been made to avoid printing
  15. values out which have no obvious purpose. In conversion to other
  16. languages, the printing may cause timing problems. Merely
  17. removing the printing statements is inadequate since then an
  18. optimizing compiler could remove many of the modules completely. }
  19.  
  20. { For details of checks and changes to avoid some problems,
  21.   see NPL report DITC 107/88. }
  22.  
  23. uses time;
  24.  
  25. const
  26.     t = 0.499975;
  27.     t1 = 0.50025;
  28.     t2 = 2.0;
  29.  
  30. type
  31.     real = double;
  32.     rlarray = array [ 1 .. 4 ] of real;
  33.  
  34. var
  35.     start, stop: LONGINT;
  36.     wt: integer;  { Determines length of execution }
  37.     x, y, z, norm, t3, estimate: real;
  38.     xx: record
  39.         one, two, three, four: real
  40.         end;
  41.     e1: rlarray;
  42.     i, jj, kk, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11: integer;
  43.     ij, ik, il: 1 .. 4;
  44.     fail: boolean;
  45.  
  46.  
  47.     procedure pa(var e: rlarray);
  48.         label 1;
  49.         var j: integer;
  50.         begin
  51.         j := 0;
  52.       1 :
  53.         e[1] := (e[1] + e[2] + e[3] - e[4]) * t;
  54.         e[2] := (e[1] + e[2] - e[3] + e[4]) * t;
  55.         e[3] := (e[1] - e[2] + e[3] + e[4]) * t;
  56.         e[4] := ( - e[1] + e[2] + e[3] + e[4]) / t3; {changed from t2}
  57.         j := j + 1;
  58.         if j < 6 then
  59.             goto 1
  60.         end; {pa}
  61.  
  62.     procedure p0;
  63.         begin
  64.         e1[ij] := e1[ik];
  65.         e1[ik] := e1[il];
  66.         e1[il] := e1[ij];
  67.         end; {p0}
  68.  
  69.     procedure p3(x, y: real; var z: real);
  70.         begin
  71.         x := t * (z + x);
  72.         y := t * (x + y);
  73.         z := (x + y) / t2
  74.         end; {p3}
  75.  
  76.     procedure Check(ModuleNo: integer; Condition: Boolean);
  77.         begin
  78.         if not Condition then
  79.            begin
  80.            writeln('Module ', ModuleNo:1, ' has not produced the expected',
  81.                    ' results');
  82.            writeln('Check listing and compare with Pascal version');
  83.            fail := true
  84.            end
  85.         end;
  86.  
  87. begin
  88.     wt := 10;   { 10 corresponds to one million Whetstone instructions
  89.                  value shouldbe read to avoid the loop counters being
  90.                  taken as constant. }
  91.     fail := false;
  92.     Check( 0, (wt >= 1) and (wt <= 100) );
  93.     n1 := 2 * wt;
  94.     n2 := 10 * wt;
  95.     n3 := 14 * wt;
  96.     n4 := 345 * wt;
  97.     n5 := 0;
  98.     n6 := 95 * wt;
  99.     n7 := 32 * wt;
  100.     n8 := 800 * wt;
  101.     n9 := 616 * wt;
  102.     n10 := 0;
  103.     n11 := 93 * wt;
  104.  
  105.     start := clock;
  106.  
  107.     { module 1: simple identifiers}
  108.     xx.one := 1.0;
  109.     xx.two := -1.0;  xx.three := -1.0;  xx.four := -1.0;
  110.     for i := 1 to n1 do
  111.         begin
  112.         xx.one := (xx.one + xx.two + xx.three - xx.four) * t;
  113.         xx.two := (xx.one + xx.two - xx.three + xx.four) * t;
  114.         xx.three := (xx.one - xx.two + xx.three + xx.four) * t;
  115.         xx.four := ( - xx.one + xx.two + xx.three + xx.four) * t
  116.         end; {module 1}
  117.     with xx do
  118.         norm := sqrt(sqr(one)+sqr(two)+sqr(three)+sqr(four));
  119.     Check(1, abs(norm - exp(0.35735-n1*6.1e-5))/norm <= 0.1 );
  120.  
  121.     { module 2: array elements}
  122.     e1[1] := 1.0;
  123.     e1[2] := -1.0;  e1[3] := - 1.0;  e1[4] := - 1.0;
  124.     for i := 1 to n2 do
  125.         begin
  126.         e1[1] := (e1[1] + e1[2] + e1[3] - e1[4]) * t;
  127.         e1[2] := (e1[1] + e1[2] - e1[3] + e1[4]) * t;
  128.         e1[3] := (e1[1] - e1[2] + e1[3] + e1[4]) * t;
  129.         e1[4] := ( - e1[1] + e1[2] + e1[3] + e1[4]) * t
  130.         end; {module 2}
  131.     norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));
  132.     Check(2, abs(norm - exp(0.35735-n2*6.1e-5))/norm <= 0.1);
  133.  
  134.     { module 3: array as parameter}
  135.     t3 := 1.0/t;
  136.     for i := 1 to n3 do
  137.         pa(e1);
  138.     norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));
  139.     Check(3, abs(norm - exp(0.35735-(n3*5+n2)*6.1e-5))/norm <= 0.1 );
  140.  
  141.     { module 4: conditional jumps}
  142.     jj := 1;
  143.     for i:= 1 to n4 do
  144.         begin
  145.         if jj = 1 then
  146.             jj := 2
  147.         else
  148.             jj := 3;
  149.         if jj > 2 then
  150.             jj := 0
  151.         else
  152.             jj := 1;
  153.         if jj < 1 then
  154.             jj := 1
  155.         else
  156.             jj := 0
  157.         end; {module 4}
  158.     Check( 4, jj = ord(not odd(wt) ) );
  159.  
  160.     { module 5: omitted}
  161.  
  162.     { module 6: integer arithmetic}
  163.     ij := 1;
  164.     ik := 2;
  165.     il := 3;
  166.     for i := 1 to n6 do
  167.         begin
  168.         ij := ij * (ik - ij) * (il - ik);
  169.         ik := il * ik - (il - ij) * ik;
  170.         il := (il - ik) * (ik + ij);
  171.         e1[il - 1] := ij + ik + il;
  172.         e1[ik - 1] := ij * ik * il
  173.         end; {module 6}
  174.     Check( 6, (ij=1) and (ik=2) and (il=3) );
  175.  
  176.     {module 7: trig. functions) }
  177.     x := 0.5;  y := 0.5;
  178.     for i := 1 to n7 do
  179.     begin
  180.         x := t * arctan(t2 * sin(x) * cos(x) /
  181.                         (cos(x + y) + cos (x - y) - 1.0));
  182.         y := t * arctan(t2 * sin(y) * cos(y) /
  183.                         (cos(x + y) + cos (x - y) - 1.0))
  184.         end; {module 7}
  185.     Check(7, (t - wt* 0.0015 <= x) and
  186.              (x <= t - wt* 0.0004) and
  187.              (t - wt* 0.0015 <= y) and
  188.              (y <= t - wt* 0.0004) );
  189.  
  190.     {module 8: procedure calls}
  191.     x := 1.0;  y := 1.0; z := 1.0;
  192.     for i := 1 to n8 do
  193.         p3(y * i, y + z, z);
  194.     Check(8, abs(z - (0.99983352*n8 - 0.999555651)) <= n8*1.0e-6);
  195.  
  196.     (* module 9: array references*)
  197.     ij := 1;
  198.     ik := 2;
  199.     il := 3;
  200.     e1[1] := 1.0;
  201.     e1[2] := 2.0;
  202.     e1[3] := 3.0;
  203.     for i := 1 to n9 do
  204.         p0;
  205.     Check(9, (e1[1] = 3.0) and (e1[2] = 2.0) and (e1[3] = 3.0) );
  206.  
  207.     { module 10: integer arithmetic}
  208.     jj := 2;
  209.     kk := 3;
  210.     for i := 1 to n10 do
  211.         begin
  212.         jj := jj + kk;
  213.         kk := jj + kk;
  214.         jj := kk - jj;
  215.         kk := kk - jj - jj;
  216.         end; {module 10}
  217.     Check(10, (jj=2) and (kk=3) );
  218.  
  219.     { module 11: standard functions}
  220.     x := 0.75;
  221.     for i := 1 to n11 do
  222.         x := sqrt (exp(ln(x) / t1));
  223.     estimate := 1.0 - exp(-0.0447*wt + ln(0.26));
  224.     Check( 11, (abs(estimate-x)/estimate
  225.                   <= 0.0006 + 0.065/(5+wt) ));
  226.  
  227.     stop := clock - start;
  228.     Writeln (100*wt/(stop*1e-3):10:3, ' DOUBLE KWhetstones');
  229. end.
  230.  
  231.  
  232.  
  233.  
  234.  
  235.